﻿'Import Section
Imports System
Imports System.IO
Imports System.Net
Imports System.Text

Public Class frmMain
    'Database
    Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim rs2 As ADODB.Recordset
    Dim recCount As Double
    Dim tblCount As Integer

    'Distance
    Dim request As WebRequest
    Dim response As HttpWebResponse
    Dim dataStream As Stream
    Dim reader As StreamReader

    Private Sub btnFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFile.Click
        FileDialog.ShowDialog()
    End Sub

    Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        con = New ADODB.Connection
        rs = New ADODB.Recordset
        rs2 = New ADODB.Recordset
        Reset()
    End Sub

    Private Sub FileDialog_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles FileDialog.FileOk
        Reset()
        txtFile.Text = FileDialog.FileName
        If txtFile.Text.Length > 0 Then
            lblFile.Visible = True
            lblFile.Text = "Loading..."
            'Database
            Try
                lblFile.Text = "Connecting..."
                con.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + txtFile.Text)
                rs = con.OpenSchema(20)
                If Not rs.BOF Then rs.MoveFirst()
                tblCount = 0
                While Not rs.EOF
                    If rs.Fields("TABLE_TYPE").Value = "TABLE" Then tblCount += 1
                    rs.MoveNext()
                End While
                If Not rs.BOF Then rs.MovePrevious()
                If Not tblCount >= 6 Then
                    MsgBox("Incorrect Database Selected!!", MsgBoxStyle.Critical, "STS - Error")
                    If con.State = 1 Then con.Close()
                    If rs.State = 1 Then rs.Close()
                    lblFile.Text = "Error Connecting to Database!! Select Correct Database"
                    Return
                End If
                If rs.State = 1 Then rs.Close()
            Catch ex As Exception
                lblFile.Text = "Error Connecting to database!!"
                MsgBox(ex.Message, MsgBoxStyle.Critical, "STS - Error")
            End Try

            'Tables
            Try
                lblFile.Text = "Retrieving required tables..."
                rs.Open("Select count(*) from Children", con, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic)
                recCount = rs.Fields(0).Value
                If rs.State = 1 Then rs.Close()
                rs.Open("SELECT * FROM Children C, School S WHERE C.SID = S.ID", con, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic)
                If Not rs.BOF Then rs.MoveFirst()

                If rs2.State = 1 Then rs2.Close()
                rs2.Open("DELETE * FROM ChildTravel", con, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic)
                If rs2.State = 1 Then rs2.Close()
                rs2.Open("SELECT * FROM ChildTravel", con, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic)
                If Not rs2.BOF Then rs2.MoveFirst()

                btnCompute.Enabled = True
                lblFile.Text = "Data Loading Done!  Click Run Model to proceed..."
            Catch ex As Exception
                lblFile.Text = "Error Retrieving Tables!!"
                MsgBox(ex.Message, MsgBoxStyle.Critical, "STS - Error")
            End Try
        End If
    End Sub

    Private Sub lblFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblFile.Click
        Dim temp As String
        Dim tmpDouble As Double

        If rs.State = 1 Then rs.Close()
        rs.Open("Select ToMode, COUNT(ToMode) from ChildTravel GROUP BY ToMode", con, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic)
        If Not rs.BOF Then rs.MoveFirst()
        temp = "Share of each mode:" + vbCr + "To School - "
        While Not rs.EOF
            tmpDouble = rs.Fields(1).Value / recCount * 100
            If rs.Fields(0).Value = 1 Then temp += vbCr + "School Bus : " + tmpDouble.ToString("N2") + "%"
            If rs.Fields(0).Value = 2 Then temp += vbCr + "Walk/Bike : " + tmpDouble.ToString("N2") + "%"
            If rs.Fields(0).Value = 3 Then temp += vbCr + "Car : " + tmpDouble.ToString("N2") + "%"
            rs.MoveNext()
        End While

        If rs2.State = 1 Then rs2.Close()
        rs2.Open("Select FrMode, COUNT(FrMode) from ChildTravel GROUP BY FrMode", con, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic)
        If Not rs2.BOF Then rs.MoveFirst()
        temp += vbCr + vbCr + "From School - "
        While Not rs2.EOF
            tmpDouble = rs2.Fields(1).Value / recCount * 100
            If rs2.Fields(0).Value = 1 Then temp += vbCr + "School Bus : " + tmpDouble.ToString("N2") + "%"
            If rs2.Fields(0).Value = 2 Then temp += vbCr + "Walk/Bike : " + tmpDouble.ToString("N2") + "%"
            If rs2.Fields(0).Value = 3 Then temp += vbCr + "Car : " + tmpDouble.ToString("N2") + "%"
            rs2.MoveNext()
        End While
        
        If rs.State = 1 Then rs.Close()
        If rs2.State = 1 Then rs2.Close()
        MsgBox(temp)
    End Sub

    Private Sub btnCompute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCompute.Click
        Dim chldAddr As String
        Dim schAddr As String
        Dim temp As Double
        Static start As DateTime
        Static finish As DateTime
        Dim elapsed As TimeSpan
        Dim fieldsArray(3) As Object
        Dim values(3) As Object

        txtFile.Enabled = False
        btnFile.Enabled = False
        btnCompute.Enabled = False
        lblFile.Visible = True

        fieldsArray(0) = "ID"
        fieldsArray(1) = "ToMode"
        fieldsArray(2) = "FrMode"
        fieldsArray(3) = "Distance"

        If Not rs.BOF Then rs.MoveFirst()
        If Not rs2.EOF Then rs2.MoveLast()
        pgbModel.Visible = True
        pgbModel.Value = 0
        pgbModel.Increment(10)
        lblFile.Text = "Calculating... 1 out of " & recCount & " records"
        start = Now
        Update()
        For i As Integer = 1 To recCount
            chldAddr = rs.Fields("StName").Value + " " + rs.Fields("StTag").Value + " " + rs.Fields("StDir").Value + " " + rs.Fields("C.City").Value + " " + rs.Fields("C.State").Value + " " + CStr(rs.Fields("C.Zip").Value)
            schAddr = rs.Fields("Address").Value + " " + rs.Fields("S.City").Value + " " + rs.Fields("S.State").Value + " " + CStr(rs.Fields("S.Zip").Value)
            temp = getDistance(chldAddr, schAddr)

            values(0) = rs.Fields("C.ID").Value
            values(1) = getToMode(temp, rs.Fields("Type").Value, rs.Fields("Grade").Value, rs.Fields("RID").Value)
            values(2) = getFrMode(temp, rs.Fields("Type").Value, rs.Fields("Grade").Value, rs.Fields("RID").Value)
            values(3) = temp
            Try
                rs2.AddNew(fieldsArray, values)
            Catch ex As Exception
                MsgBox(ex.Message, MsgBoxStyle.Critical, "STS - Error")
                End
            End Try

            If Not rs.EOF Then rs.MoveNext()
            chldAddr = " "
            schAddr = " "
            temp = -1
            If i Mod 10 = 0 Then
                lblFile.Text = "Calculating... " & i & " out of " & recCount & " records"
                pgbModel.Increment(10)
                Update()
            End If
        Next
        rs2.Update()
        If rs.State = 1 Then rs.Close()
        If rs2.State = 1 Then rs2.Close()
        finish = Now
        elapsed = finish.Subtract(start)
        lblFile.Text = "Model Completed in " + elapsed.TotalSeconds.ToString("N2") + " seconds! Click here for summary!"
        lblFile.Enabled = True
        txtFile.Enabled = True
        btnFile.Enabled = True
    End Sub

    Private Function getDistance(ByVal frAddr, ByVal toAddr)
        request = WebRequest.Create("http://maps.google.com/maps?saddr=" + frAddr + "&daddr=" + toAddr + "&output=dragdir")
        response = CType(request.GetResponse(), HttpWebResponse)
        If response.StatusDescription = "OK" Then
            dataStream = response.GetResponseStream()
            reader = New StreamReader(dataStream)
            Dim split As String() = reader.ReadToEnd().Split(New [Char]() {"("c, "\"c, "x"c}, 3)
            reader.Close()
            dataStream.Close()
            response.Close()
            Return split(1)
        Else
            Return -1
        End If
    End Function

    Private Sub Reset()
        lblFile.Text = ""
        lblFile.Visible = False
        lblFile.Enabled = False
        txtFile.Text = ""
        txtFile.Enabled = True
        btnFile.Enabled = True
        pgbModel.Visible = False
        btnCompute.Enabled = False
        If rs.State = 1 Then rs.Close()
        If rs2.State = 1 Then rs2.Close()
        If con.State = 1 Then con.Close()
    End Sub

    Private Function getToMode(ByVal distance, ByVal type, ByVal grade, ByVal race)
        Dim toBus As Double
        Dim toWalk As Double
        Dim probBusTo As Double
        Dim probWalkTo As Double
        Dim probAutoTo As Double
        Dim rand As New Random

        toBus = -1.269 - 0.195
        toWalk = -1.269 - 0.195

        'Distance
        If distance > 0.25 And distance <= 0.5 Then
            toBus += 0.379
            toWalk += 0.339
        End If
        If distance > 0.5 And distance <= 0.75 Then
            toBus += 0.292
            toWalk -= 1.828
        End If
        If distance > 0.75 And distance <= 1.0 Then
            toBus += 1.729
            toWalk -= 1.765
        End If
        If distance > 1.0 And distance <= 1.5 Then
            toBus += 1.851
            toWalk -= 3.272
        End If
        If distance > 1.5 And distance <= 2.0 Then
            toBus += 2.465
            toWalk -= 4.304
        End If
        If distance > 2.0 And distance <= 3.0 Then
            toBus += 2.279
            toWalk -= 5.601
        End If
        If distance > 3.0 Then
            toBus += 2.741
            toWalk -= 4.268
        End If

        'Type
        If type = 1 Then
            toBus += 0.939
            toWalk -= 0.022
        End If

        'Grade
        If grade = 1 Then
            toBus += 0.33
            toWalk += 0.32
        End If
        If grade = 2 Then
            toBus -= 0.19
            toWalk += 0.339
        End If
        If grade = 3 Then
            toBus += 0.568
            toWalk -= 0.776
        End If
        If grade = 4 Then
            toBus += 0.233
            toWalk += 0.377
        End If
        If grade = 5 Then
            toBus += 0.757
            toWalk += 0.71
        End If
        If grade = 6 Then
            toBus += 1.662
            toWalk += 1.663
        End If

        'Race
        If race = 1 Then
            toBus -= 1.145
            toWalk += 0.052
        End If

        toBus = Math.Exp(toBus)
        toWalk = Math.Exp(toWalk)

        probBusTo = toBus / (1 + toBus + toWalk)
        probWalkTo = toWalk / (1 + toBus + toWalk)
        probAutoTo = 1 / (1 + toBus + toWalk)

        Dim i As Double
        i = rand.NextDouble
        If (i <= probBusTo) Then
            'School Bus
            Return 1
        ElseIf (i <= (probBusTo + probWalkTo)) Then
            'Walk or Bike
            Return 2
        Else
            'car
            Return 3
        End If
        Return -1
    End Function

    Private Function getFrMode(ByVal distance, ByVal type, ByVal grade, ByVal race)
        Dim frBus As Double
        Dim frWalk As Double
        Dim probBusFr As Double
        Dim probWalkFr As Double
        Dim probAutoFr As Double
        Dim rand As New Random

        frBus = -1.269
        frWalk = -1.269

        'Distance
        If distance > 0.25 And distance <= 0.5 Then
            frBus += 0.379
            frWalk += 0.339
        End If
        If distance > 0.5 And distance <= 0.75 Then
            frBus += 0.292
            frWalk -= 1.828
        End If
        If distance > 0.75 And distance <= 1.0 Then
            frBus += 1.729
            frWalk -= 1.765
        End If
        If distance > 1.0 And distance <= 1.5 Then
            frBus += 1.851
            frWalk -= 3.272
        End If
        If distance > 1.5 And distance <= 2.0 Then
            frBus += 2.465
            frWalk -= 4.304
        End If
        If distance > 2.0 And distance <= 3.0 Then
            frBus += 2.279
            frWalk -= 5.601
        End If
        If distance > 3.0 Then
            frBus += 2.741
            frWalk -= 4.268
        End If

        'Type
        If type = 1 Then
            frBus += 0.939
            frWalk -= 0.022
        End If

        'Grade
        If grade = 1 Then
            frBus += 0.33
            frWalk += 0.32
        End If
        If grade = 2 Then
            frBus -= 0.19
            frWalk += 0.339
        End If
        If grade = 3 Then
            frBus += 0.568
            frWalk -= 0.776
        End If
        If grade = 4 Then
            frBus += 0.233
            frWalk += 0.377
        End If
        If grade = 5 Then
            frBus += 0.757
            frWalk += 0.71
        End If
        If grade = 6 Then
            frBus += 1.662
            frWalk += 1.663
        End If

        'Race
        If race = 1 Then
            frBus -= 1.145
            frWalk += 0.052
        End If

        frBus = Math.Exp(frBus)
        frWalk = Math.Exp(frWalk)

        probBusFr = frBus / (1 + frBus + frWalk)
        probWalkFr = frWalk / (1 + frBus + frWalk)
        probAutoFr = 1 / (1 + frBus + frWalk)

        Dim i As Double
        i = rand.NextDouble
        If (i <= probBusFr) Then
            'School Bus
            Return 1
        ElseIf (i <= (probBusFr + probWalkFr)) Then
            'Walk or Bike
            Return 2
        Else
            'car
            Return 3
        End If
        Return -1
    End Function


    



End Class